perm filename AREAS.SAI[PUB,TES] blob
sn#195730 filedate 1976-01-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00014 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGOF("AREAS")
C00004 00003 PUBLIC SIMPLE PROCEDURE AREAS! $"#
C00005 00004 PUBLIC RECURSIVE PROCEDURE ASSUREAREA $"#
C00006 00005 PUBLIC PROCEDURE BURPAREAS(BOOLEAN VERBOSE) $"#
C00013 00006 PUBLIC RECURSIVE PROCEDURE CLOSEAREA(INTEGER ITSIX BOOLEAN DISDECLAREIT) $"#
C00015 00007 PUBLIC RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) $"#
C00018 00008 PUBLIC RECURSIVE PROCEDURE DCLOSE $"#
C00019 00009 PUBLIC SIMPLE PROCEDURE GROWAA(INTEGER HOWMUCH) $"#
C00020 00010 PUBLIC SIMPLE PROCEDURE MAKEAREA(INTEGER ITSIX) $"#
C00022 00011 PUBLIC SIMPLE PROCEDURE PLACE(INTEGER NEWAREAIX) $"#
C00025 00012 PUBLIC RECURSIVE PROCEDURE OPENAREA(INTEGER ITSIX) $"#
C00028 00013 PUBLIC SIMPLE PROCEDURE REMNULLS $"#
C00029 00014 FINISHED
C00030 ENDMK
C⊗;
BEGOF("AREAS")
COMMENT
An area declaration results in a declaration record of type AREATYPE
on the ISTK stack. Each instantiation of an area on some page
results in a distinct instantiation record allocated as a new dynamic
array.
An instantiated area proceeds through three or four stages of status:
made but unopened, opened, closed, [and disdeclared]. PLACE makes
unopened areas, PLACELINE forces the area to open, filling it up or
closing the page causes the area to close, and the END of the block
in which it is declared causes it to be (closed and) dis-declared.
;
PROCEDURES
PUBLIC SIMPLE PROCEDURE AREAS! ;$"#
BEGIN "AREAS!"
AVAILREC[0] ← NULLAREAS ← 0 ;
SYMTEXT ← SYMNUM("TEXT") ;
END "AREAS!" ;
PUBLIC RECURSIVE PROCEDURE ASSUREAREA ;$"#
IF AREAIDA = 0 OR STATUS NEQ 1 THEN OPENAREA(IF AREAIXM THEN AREAIXM ELSE IXTEXT) ;
PUBLIC PROCEDURE BURPAREAS(BOOLEAN VERBOSE) ;$"#
BEGIN TES 8/19/74 CALLED BY DBURP ;
INTEGER NAREAS ; INTEGER ARRAY FOUND[1:100], THISAREA[0:ONE], AA[0:ONE,0:ONE] ;
PROCEDURE BURPAREADECL(INTEGER ILOC, IDA) ;
BEGIN
INTEGER I ;
OUTSTR(
(IF TEXTAR(ILOC) THEN NULL ELSE "TITLE ") &
"AREA " & SYM[LDB(BIXNUM(ILOC))] &
" LINES " & CVS(LINE1(ILOC)) & " TO " & CVS(LINE1(ILOC)+LINECT(ILOC)-1) &
" CHARS " & CVS(CHAR1(ILOC)) & " TO " & CVS(CHAR1(ILOC)+CHARCT(ILOC)-1) &
(IF (I←COLCT(ILOC)) NEQ 1 THEN " IN " & CVS(I) & " COLUMNS " &
CVS(COLWID(ILOC)) & " WIDE" ELSE NULL) &
CRLF & " " &
(IF DISD(ILOC) THEN "DISDECLARED " ELSE "DECLARED ") &
(IF FULHIGH(ILOC) THEN "FULL HEIGHT " ELSE NULL) &
(IF FULWIDE(ILOC) THEN "FULL WIDTH " ELSE NULL) &
"AT " & CVOS(ISTKIDA+ILOC) &
(IF (I ← OLD!ACTIVE(ILOC)) AND I NEQ IDA THEN " RECORD "&CVOS(I) ELSE NULL) &
(IF (I ← NEW!ACTIVE(ILOC)) THEN "NEWPAGE RECORD " & CVOS(I) ELSE NULL) &
(IF (I←MARGINS(ILOC)) THEN " MARGINS " & CVS(LMARGX(I)) & SP & CVS(RMARGX(I)) ELSE NULL) &
(IF XCRIBL THEN " FONTS " & PICKFONT(TFONT(ILOC))[3 TO ∞] &
"*" & PICKFONT(OFONT(ILOC))[3 TO ∞] ELSE NULL) &
(IF FULSTR(SSTK[FOOTSTR(ILOC)]) THEN " FOOTNOTES PENDING" ELSE NULL) &
CRLF) ;
END "BURPAREADECL" ;
PROCEDURE BURPAREARECORD(INTEGER ARIDA; BOOLEAN INFRAME) ;
BEGIN
INTEGER COLS, LINES, I, J, X, Y ;
INTEGER PCOL, PLINE, PPINE ;
BOOLEAN SOME ;
IDASSIGN(ARIDA, THISAREA) ;
IDASSIGN(AAA, AA) ;
IF (I←DEFA) THEN BEGIN FOUND[NAREAS←NAREAS+1]←I ; BURPAREADECL(I, ARIDA) END ;
COLS ← ARRINFO(AA, 2)/2 ; LINES ← ARRINFO(AA,4) ;
IF STATA=1 THEN TES 8/26/74 IT IS OPEN ;
IF AREAIDA=ARIDA THEN COMMENT IT'S CURRENT ;
BEGIN
PCOL ← COL ; PLINE ← LINE ; PPINE ← PINE ;
END
ELSE BEGIN
PCOL ← COLA ;
PLINE ← RH(AA[PCOL,0]) ;
PPINE ← RH(AA[(COLS+COLS-1) MOD (2*COLS) +1, 0]) ;
END ;
IF STATA > 1 THEN
OUTSTR("AREA ? LINES " & CVS(ULLA) & " TO " &
CVS(ULLA+LINECA-1) & " CHARS " & CVS(RH(AA[1,0])) &
" TO ? IN " & CVS(COLCA) & " COLUMNS" & CRLF) ;
OUTSTR(TB &
(IF NOT INFRAME THEN " NOT IN FRAME"
ELSE IF INA NEQ FRAMEIDA THEN " ** FRAME BACKLINK INCORRECT**"
ELSE NULL) &
(CASE STATA OF (" UNOPENED", " OPENED", " CLOSED", " DIS-DECLARED")) &
" AT " & CVOS(ARIDA) &
(IF AREAIDA=ARIDA THEN " (CURRENT)" ELSE NULL) &
(IF XCRIBL THEN
(IF XGENA THEN " XGENLINES = "&CVS(XGENA) ELSE NULL)&
(IF OVERA THEN " OVEREST OF COLUMN 1 = "&CVS(OVERA) ELSE NULL)
ELSE NULL) &
(IF STATA=1 THEN
" PLACED "&CVS(PLINE)&" LINES IN COLUMN "&
CVS(IF PCOL>COLS THEN PCOL-COLS ELSE PCOL) &
(IF PCOL>COLS THEN " FOOT" ELSE NULL) &
(IF PCOL>COLS OR PPINE THEN " ("&CVS(PPINE)&" IN THE " &
(IF PCOL>COLS THEN "LEG)" ELSE "FOOT)")
ELSE NULL)
ELSE NULL) &
CRLF) ;
IF VERBOSE THEN
BEGIN
OUTSTR(TB&" LINE"&TB) ;
FOR I←1 THRU COLS DO OUTSTR(" COLUMN "&CVS(I)&TB) ;
OUTSTR(CRLF & TB & TB) ;
FOR I ← 1 THRU COLS DO OUTSTR(" CALF FOOT"&TB) ;
OUTSTR(CRLF) ;
FOR J ← 1 THRU LINES DO
BEGIN
SOME ← FALSE ;
FOR I ← 1 THRU 2*COLS DO IF AA[I,J] THEN BEGIN SOME←TRUE;DONE END ;
IF SOME THEN
BEGIN
OUTSTR(TB & " " & CVS(J) & TB) ;
FOR I ← 1 THRU COLS DO
FOR Y←0,COLS DO
OUTSTR(IF (X←AA[I+Y,J]) THEN (" "&CVS(OWLS[X]))[∞-5 TO ∞]&TB ELSE TB) ;
OUTSTR(CRLF) ;
END ;
END ;
END ;
END "BURPAREARECORD" ;
INTEGER A, I, THISIDA, AAIDA ; BOOLEAN DID ;
THISIDA ← WHATIS(THISAREA) ; AAIDA ← WHATIS(AA) ;
IF FRAMEIDA=0 THEN OUTSTR("BETWEEN PAGES"&CRLF) TES 8/26/74 ;
ELSE BEGIN
A ← ARF ; NAREAS ← 0 ;
WHILE A DO
BEGIN COMMENT SEARCH THIS FRAME ;
BURPAREARECORD(A, TRUE) ;
A ← ARA ;
END ;
END ;
A ← NULLAREAS ;
WHILE A DO
BEGIN COMMENT SEARCH NULL AREAS LIST (MADE BUT UNOPENED) ;
BURPAREARECORD(A, FALSE) ;
A ← RH(INA) ;
END ;
A ← IHED ;
WHILE A > 1 DO
BEGIN COMMENT SEARCH ISTK ;
IF IXTYPE(A) = AREATYPE THEN
BEGIN
DID ← FALSE ;
FOR I ← 1 THRU NAREAS DO IF FOUND[I]=A THEN
BEGIN DID ← TRUE ; DONE END ;
IF NOT DID THEN BURPAREADECL(A, 0) ;
END ;
A ← IXOLD(A) ;
END ;
MAKEBE(THISIDA, THISAREA) ; MAKEBE(AAIDA, AA) ;
END "BURPAREAS" ;
PUBLIC RECURSIVE PROCEDURE CLOSEAREA(INTEGER ITSIX; BOOLEAN DISDECLAREIT) ;$"#
BEGIN "CLOSEAREA"
INTEGER SAVAR, C, WC, NC, CC, LEFC ; BOOLEAN NORESP ;
NORESP ← ITSIX < 0 ; ITSIX ← ABS(ITSIX) ;
IF DISDECLAREIT THEN OLMAX ← OLMAX - LINECT(ITSIX)*COLCT(ITSIX) ;
IF OPEN!ACTIVE(ITSIX) = 0 THEN IF DISDECLAREIT THEN CLOSET(ITSIX, FALSE, TRUE)
ELSE BEGIN END
ELSE BEGIN SAVAR←AREAIXM; PLACE(ITSIX); IF STATUS=0 THEN REMNULLS ; STATA ← STATUS←2;
ULLA ← LINE1(ITSIX) ; AA[1,0] ← LEFC ← CHAR1(ITSIX) ;
IF (NC ← COLCT(ITSIX)) > 1 THEN
BEGIN
WC ← COLWID(ITSIX) ; CC ← CHARCT(ITSIX) ;
FOR C ← 2 THRU NC DO AA[C,0] ← LEFC + ((C-1)*(CC-WC)) DIV (NC-1) ;
END ;
LINECA ← LINECT(ITSIX) ; COLCA ← NC ;
IF NOT NORESP THEN CLOSET(ITSIX, TRUE, DISDECLAREIT) ;
IF DISDECLAREIT THEN BEGIN STATA ← STATUS←3 ; DEFA ← 0 END ;
OPEN!ACTIVE(ITSIX) ← AREAIDA ← 0 ;
IF SAVAR AND NOT DISDECLAREIT AND SAVAR NEQ ITSIX THEN PLACE(SAVAR) ELSE BEGIN AREAIXM←0; STATUS←-1 END ;
END ;
END "CLOSEAREA" ;
PUBLIC RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;$"#
BEGIN
INTEGER I, IX, SYMB, TEMP, A, B ;
PRELOAD!WITH "LINE", "TO", "CHAR", "TO", "IN", "COLUMN", "COLUMN" ;
OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
PRELOAD!WITH NULL, NULL, NULL, NULL, NULL, "WIDE", "APART" ;
OWN STRING ARRAY POST[1:7] ;
DBREAK; DPASS ;
IF NOT THISISID THEN BEGIN WARN("=","AREA must have name"); THISWD←"!DUMMY" END ;
SYMB ← SYMNUM(THISWD) ;
PASS ;
PARAMS(7, PRE, PAR, POST) ;
IF NOT ON THEN RETURN ;
BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
ELSE BEGIN A ← CVD(PAR[1]) ; B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
LINE1(IX) ← A MAX 1 ; LINECT(IX) ← B-A+1 MAX 1 ;
IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
ELSE BEGIN A ← CVD(PAR[3]) ; B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
CHAR1(IX) ← A MAX 1 ; CHARCT(IX) ← B←B-A+1 MAX 1 ;
TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
ELSE BEGIN "COLUMNS"
A ← CVD(PAR[5]) ; comment How many ;
IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN B DIV A
ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
END "COLUMNS" ;
COLCT(IX) ← A MAX 1 ; COLWID(IX) ← B MAX 1 ;
OLMAX ← OLMAX + A*LINECT(IX) ;
FOOTSTR(IX) ← PUSHS(1, NULL) ;
MARGINS(IX) ← FONTSIX(IX) ← 0 ; TES 11/15/73 ;
MILLSKIP(IX) ← MILLGSKIP(IX) ← 0 ; TES 11/7/74 ;
TFONT(IX) ← OFONT(IX) ← DEFAULTFONT ; TES 11/15/73 ;
END "DAREA" ;
PUBLIC RECURSIVE PROCEDURE DCLOSE ;$"#
BEGIN
DBREAK ; PASS ;
IF ON THEN
IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
PASS ;
END "DCLOSE" ;
PUBLIC SIMPLE PROCEDURE GROWAA(INTEGER HOWMUCH) ;$"#
BEGIN "GROWAA" TES 11/6/74 ;
AAA ← BIGGR2(AAA, HOWMUCH) ;
IDASSIGN(AAA, AA) ;
END "GROWAA" ;
PUBLIC SIMPLE PROCEDURE MAKEAREA(INTEGER ITSIX) ;$"#
BEGIN "MAKEAREA"
INTEGER C, L, CS, LS, NCH, OCH, C1, CC, FW, L1, LC, FH ;
C1 ← CHAR1(ITSIX) ; CC ← CHARCT(ITSIX) ;
FW ← IF FRAMEIDA THEN WIDEF ELSE FWIDE ;
L1 ← LINE1(ITSIX) ; LC ← LINECT(ITSIX) ;
FH ← IF FRAMEIDA THEN HIGHF ELSE FHIGH ;
IF FULWIDE(ITSIX) THEN
BEGIN Comment Make frame width ;
OCH ← CC ; CHARCT(ITSIX) ← NCH ← FW ;
COLWID(ITSIX) ← (COLWID(ITSIX) * NCH) DIV OCH ;
END ;
IF FULHIGH(ITSIX) THEN LINECT(ITSIX) ← FH ;
L←OPEN!ACTIVE(ITSIX)←CREATE(0, AREC) ;
IF NULLAREAS THEN BEGIN IDASSIGN(AREAIDA←NULLAREAS,THISAREA) ; INA←LHRH(L,INA) END ;
IDASSIGN(AREAIDA ← L, THISAREA) ;
DEFA ← ITSIX ; STATA ← 0 ; INA ← LHRH(0, NULLAREAS) ; NULLAREAS ← AREAIDA ;
IDASSIGN(AAA←CREATE2(1, CS←COLCT(ITSIX)*2, 0, LS←LC+((LC DIV 2) MAX 8) ) , AA) ;
ZEROWORDS(CS*(LS+1), AA[1,0]) ;
COMMENT FOR C ← 1 THRU CS DO FOR L ← 0 THRU LS DO AA[C,L] ← 0 ;
END "MAKEAREA" ;
PUBLIC SIMPLE PROCEDURE PLACE(INTEGER NEWAREAIX) ;$"#
COMMENT If No Place Area, AREAIXM=0. AREAIDA NEQ 0 if STATUS= 0 or 1 ;
IF ON THEN
BEGIN "PLACE"
INTEGER FRM, ALLOW!FOR, MARGIX, FONTIX ;
IF IXTYPE(NEWAREAIX) NEQ AREATYPE THEN
BEGIN WARN("=","PLACE in non-area"); NEWAREAIX←IXTEXT END;
IF AREAIXM THEN
BEGIN TES 11/19/73 ;
TFONT(AREAIXM) ← THISFONT ;
OFONT(AREAIXM) ← OLDFONT ;
END ;
IF AREAIDA AND STATUS=1 THEN
BEGIN
COLA ← COL ; AA[COL,0] ← LHRH(COVERED,LINE) ; AA[PAL,0]←LHRH(COVERED,PINE) ; STATA←STATUS ;
XGENA ← XGENLINES; RKJ;
OVERA ← OVEREST ; TES 11/15/73;
IF AREAIXM=NEWAREAIX THEN RETURN
ELSE IF COL>COLS THEN BEGIN WARN("=","Can't PLACE inside footnotes!") ; RETURN END ;
END ;
IF XCRIBL AND AREAIXM NEQ NEWAREAIX THEN
BEGIN INTEGER DUMMY ;TES 11/15/73 ;
THISFONT ← TFONT(NEWAREAIX) ; OLDFONT ← OFONT(NEWAREAIX) ;
IF (DUMMY←FNTFIL[THISFONT])>0 THEN MAKEBE(DUMMY, CW) ;
END ;
AREAIXM←NEWAREAIX ;
IF (AREAIDA ← OPEN!ACTIVE(AREAIXM)) = 0 THEN MAKEAREA(AREAIXM)
ELSE BEGIN MAKEBE(AREAIDA, THISAREA) ; IDASSIGN(AAA, AA) ; END ;
IF (MARGIX ← MARGINS(AREAIXM)) = 0 THEN BEGIN LMARG ← 0 ; RMARG ← COLWID(AREAIXM) END
ELSE BEGIN LMARG ← LMARGX(MARGIX) ; RMARG ← RMARGX(MARGIX) END ;
ALLOW!FOR ← 2 * COLWID(AREAIXM) ;
IF ALLOW!FOR > LENGTH(OWL) THEN OWL ← OWL & SP & SPS(ALLOW!FOR - LENGTH(OWL)) ;
COLS ← COLCT(AREAIXM) ; LINES ← LINECT(AREAIXM) ; STATUS ← STATA ;
IF STATUS=1 THEN
BEGIN "IT'S OPEN"
COL ← COLA ; PAL ← (COL+COLS-1) MOD (2*COLS) + 1 ; COMMENT, Leg SWAP Foot;
LINE ← AA[COL,0] ; COVERED ← LH(LINE) ; LINE ← RH(LINE) ; PINE ← RH(AA[PAL,0]) ;
XGENLINES ← XGENA; RKJ;
OVEREST ← OVERA ; TES 11/15/73 ;
END "IT'S OPEN"
ELSE COL←PAL←LINE←COVERED←PINE←XGENLINES←OVEREST←0 ; RKJ ADDED XGENLINES;
TES ADDED OVEREST 11/15/73;
END "PLACE" ;
PUBLIC RECURSIVE PROCEDURE OPENAREA(INTEGER ITSIX) ;$"#
BEGIN "OPENAREA"
INTEGER X, PREV, NEX, C1, CC, L1, LC ;
IF FRAMEIDA=0 THEN OPENPAGE ; PLACE(ITSIX) ; IF STATUS=1 THEN RETURN ; REMNULLS ;
C1 ← CHAR1(ITSIX) ; CC ← CHARCT(ITSIX) ;
L1 ← LINE1(ITSIX) ; LC ← LINECT(ITSIX) ;
IF C1+CC-1 > WIDEF THEN
WARN(NULL,"AREA " & SYM[LDB(BIXNUM(ITSIX))] & " is wider than PAGE FRAME"&CRLF&
"CHARS " & CVS(C1) & " TO " & CVS(C1+CC) &
" exceeds " & CVS(WIDEF) & " WIDE") ;
IF L1+LC-1 > HIGHF THEN
WARN(NULL,"AREA " & SYM[LDB(BIXNUM(ITSIX))] & " is higher than PAGE FRAME"&CRLF&
"LINES " & CVS(L1) & " TO " & CVS(L1+LC) &
" exceeds " & CVS(HIGHF) & " HIGH") ;
INA ← FRAMEIDA ;
PREV ← 0 ; NEX ← ARF ; X ← AREAIDA ; COMMENT KEEP AREAS SORTED BY LEFT EDGE ;
IF C1 > 1 THEN WHILE NEX DO
BEGIN
IDASSIGN(AREAIDA←NEX, THISAREA) ;
IF DEFA THEN IF CHAR1(DEFA) GEQ C1 THEN DONE ELSE BEGIN END
ELSE BEGIN IDASSIGN(AAA,AA) ; IF AA[1,0] GEQ C1 THEN DONE ; END ;
PREV ← AREAIDA ; NEX ← ARA ;
END ;
IF PREV THEN
BEGIN TES AND DCS REVISED 9/24/73@SU, 10/25/73@PARC ;
IDASSIGN(AREAIDA←PREV, THISAREA) ; TES ADDED THIS ;
ARA ← X ;
END
ELSE ARF ← X ;
IDASSIGN(AREAIDA←X, THISAREA) ; ARA ← NEX ;
IDASSIGN(AAA, AA) ; TES 8/27/74 FIX BUG !!;
STATA ← STATUS←1 ; COL ← 1 ; PAL ← COLS + 1 ;
IF FINDTRAN(LDB(BIXNUM(ITSIX)), 4) THEN RESPOND(LLTHIS) ; comment BEFORE areaname ... ;
END "OPENAREA" ;
PUBLIC SIMPLE PROCEDURE REMNULLS ;$"#
BEGIN "REMNULLS"
INTEGER L, R, I ;
L ← LH(INA) ; R ← RH(INA) ;
IF L OR R THEN
BEGIN
I ← AREAIDA ;
IF L THEN BEGIN IDASSIGN(AREAIDA←L,THISAREA); DPB(R, H2(INA)) ; END ELSE NULLAREAS ← R ;
IF R THEN BEGIN IDASSIGN(AREAIDA←R,THISAREA); DPB(L, H1(INA)) ; END ;
IDASSIGN(AREAIDA ← I, THISAREA) ;
END
ELSE NULLAREAS ← 0 ;
END "REMNULLS" ;
FINISHED
ENDOF("AREAS")